home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / turbtool.arc / CHAPTER3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-04-01  |  11.6 KB  |  595 lines
  1. {$A-}
  2. PROGRAM CHAPTER3;
  3. {$I TOOLU.PAS}
  4. VAR CMDPTR:FILE;
  5. PROCEDURE COMPARE;FORWARD;
  6. PROCEDURE INCLUDE;FORWARD;
  7. PROCEDURE CONCAT;FORWARD;
  8.  
  9. PROCEDURE MAKECOPY;
  10. VAR
  11.   INNAME,OUTNAME:XSTRING;
  12.   FIN,FOUT:FILEDESC;
  13. BEGIN
  14.   IF(NOT GETARG(2,INNAME,MAXSTR))
  15.     OR (NOT GETARG(3,OUTNAME,MAXSTR))THEN
  16.       ERROR('USAGE:MAKECOPY OLD NEW');
  17.   FIN:=MUSTOPEN(INNAME,IOREAD);
  18.   FOUT:=MUSTCREATE(OUTNAME,IOWRITE);
  19.   FCOPY(FIN,FOUT);
  20.   XCLOSE(FIN);
  21.   XCLOSE(FOUT)
  22. END;
  23.  
  24. PROCEDURE PRINT;
  25. VAR
  26.   NAME:XSTRING;
  27.   NULL:XSTRING;
  28.   I:INTEGER;
  29.   FIN:FILEDESC;
  30.   JUNK:BOOLEAN;
  31.  
  32. PROCEDURE FPRINT(VAR NAME:XSTRING;FIN:FILEDESC);
  33. CONST
  34.   MARGIN1=2;
  35.   MARGIN2=2;
  36.   BOTTOM=64;
  37.   PAGELEN=66;
  38. VAR
  39.   LINE:XSTRING;
  40.   LINENO,PAGENO:INTEGER;
  41.  
  42. PROCEDURE SKIP(N:INTEGER);
  43. VAR
  44.   I:INTEGER;
  45. BEGIN
  46.   FOR I:=1 TO N DO
  47.     PUTC(NEWLINE)
  48. END;
  49.  
  50. PROCEDURE HEAD(VAR NAME:XSTRING;PAGENO:INTEGER);
  51. VAR
  52.   PAGE:XSTRING;
  53. BEGIN
  54.   PAGE[1]:=ORD(' ');
  55.   PAGE[2]:=ORD('P');
  56.   PAGE[3]:=ORD('a');
  57.   PAGE[4]:=ORD('g');
  58.   PAGE[5]:=ORD('e');
  59.   PAGE[6]:=ORD(' ');
  60.   PAGE[7]:=ENDSTR;
  61.   PUTSTR(NAME,STDOUT);
  62.   PUTSTR(PAGE,STDOUT);
  63.   PUTDEC(PAGENO,1);
  64.   PUTC(NEWLINE)
  65. END;
  66.  
  67. BEGIN(*FPRINT*)
  68.   PAGENO:=1;
  69.   SKIP(MARGIN1);
  70.   HEAD(NAME,PAGENO);
  71.   SKIP(MARGIN2);
  72.   LINENO:=MARGIN1+MARGIN2+1;
  73.   WHILE(GETLINE(LINE,FIN,MAXSTR))DO BEGIN
  74.     IF(LINENO=0)THEN BEGIN
  75.       SKIP(MARGIN1);;
  76.       PAGENO:=PAGENO+1;
  77.       HEAD(NAME,PAGENO);
  78.       SKIP(MARGIN2);
  79.       LINENO:=MARGIN1+MARGIN2+1
  80.     END;
  81.     PUTSTR(LINE,STDOUT);
  82.     LINENO:=LINENO+1;
  83.     IF(LINENO>=BOTTOM)THEN BEGIN
  84.       SKIP(PAGELEN-LINENO);
  85.       LINENO:=0
  86.     END
  87.   END;
  88.   IF(LINENO>0)THEN
  89.     SKIP(PAGELEN-LINENO)
  90. END;
  91.   
  92. BEGIN(*PRINT*)
  93.   NULL[1]:=ENDSTR;
  94.   IF(NARGS=1)THEN
  95.     FPRINT(NULL,STDIN)
  96.   ELSE
  97.     FOR I:=2 TO NARGS DO BEGIN
  98.       JUNK:=GETARG(I,NAME,MAXSTR);
  99.       FIN:=MUSTOPEN(NAME,IOREAD);
  100.       FPRINT(NAME,FIN);
  101.       XCLOSE(FIN)
  102.     END
  103. END;
  104.  
  105. PROCEDURE COMPARE;
  106. VAR
  107.   LINE1,LINE2:XSTRING;
  108.   ARG1,ARG2:XSTRING;
  109.   LINENO:INTEGER;
  110.   INFILE1,INFILE2:FILEDESC;
  111.   F1,F2:BOOLEAN;
  112.   
  113. PROCEDURE DIFFMSG (N:INTEGER; VAR LINE1,LINE2:XSTRING);
  114. BEGIN
  115.   PUTDEC(N,1);
  116.   PUTC(COLON);
  117.   PUTC(NEWLINE);
  118.   PUTSTR(LINE1,STDOUT);
  119.   PUTSTR(LINE2,STDOUT)
  120. END;
  121.  
  122. BEGIN(*COMPARE*)
  123.   IF (NOT GETARG(2,ARG1,MAXSTR))
  124.    OR (NOT GETARG(3,ARG2,MAXSTR)) THEN
  125.      ERROR('USAGE:COMPARE FILE1 FILE2');
  126.   INFILE1:=MUSTOPEN(ARG1,IOREAD);
  127.   INFILE2:=MUSTOPEN(ARG2,IOREAD);
  128.   LINENO:=0;
  129.   REPEAT
  130.     LINENO:=LINENO+1;
  131.     F1:=GETLINE(LINE1,INFILE1,MAXSTR);
  132.     F2:=GETLINE(LINE2,INFILE2,MAXSTR);
  133.     IF (F1 AND F2) THEN
  134.       IF (NOT EQUAL(LINE1,LINE2)) THEN
  135.         DIFFMSG(LINENO,LINE1,LINE2)
  136.   UNTIL (F1=FALSE) OR (F2=FALSE);
  137.   IF(F2 AND NOT F1) THEN
  138.   WRITELN('COMPARE:END OF FILE ON FILE 1')
  139.   ELSE IF (F1 AND NOT F2) THEN
  140.     WRITELN('COMPARE:END OF FILE ON FILE2')
  141. END;
  142.  
  143.  
  144. PROCEDURE INCLUDE;
  145. VAR
  146.   INCL:XSTRING;
  147.  
  148. PROCEDURE FINCLUDE(F:FILEDESC);
  149. VAR
  150.   LINE,STR:XSTRING;
  151.   LOC,I:INTEGER;
  152.   F1:FILEDESC;
  153. FUNCTION GETWORD(VAR S:XSTRING;I:INTEGER;
  154.   VAR OUT:XSTRING):INTEGER;
  155.  
  156. VAR
  157.   J:INTEGER;
  158. BEGIN
  159.   WHILE(S[I] IN [BLANK,TAB,NEWLINE]) DO
  160.     I:=I+1;
  161.   J:=1;
  162.   WHILE(NOT (S[I] IN [ENDSTR,BLANK,TAB,NEWLINE])) DO BEGIN
  163.     OUT[J]:=S[I];
  164.     I:=I+1;
  165.     J:=J+1
  166.   END;
  167.   OUT[J]:=ENDSTR;
  168.   IF(S[I]=ENDSTR) THEN
  169.     GETWORD:=0
  170.   ELSE
  171.     GETWORD:=I
  172. END;
  173.  
  174. BEGIN
  175.   WHILE (GETLINE(LINE,F,MAXSTR))DO BEGIN
  176.     LOC:=GETWORD(LINE,1,STR);
  177.     IF (NOT EQUAL(STR,INCL)) THEN
  178.       PUTSTR(LINE,STDOUT)
  179.     ELSE BEGIN
  180.       LOC:=GETWORD(LINE,LOC,STR);
  181.       STR[XLENGTH(STR)]:=ENDSTR;
  182.       FOR I:= 1 TO XLENGTH(STR)DO
  183.         STR[I]:=STR[I+1];
  184.       F1:=MUSTOPEN(STR,IOREAD);
  185.       FINCLUDE(F1);
  186.       XCLOSE(F1)
  187.     END
  188.   END
  189. END;
  190.  
  191. BEGIN
  192.   INCL[1]:=ORD('#');
  193.   INCL[2]:=ORD('i');
  194.   INCL[3]:=ORD('n');
  195.   INCL[4]:=ORD('c');
  196.   INCL[5]:=ORD('l');
  197.   INCL[6]:=ORD('u');
  198.   INCL[7]:=ORD('d');
  199.   INCL[8]:=ORD('e');
  200.   INCL[9]:=ENDSTR;
  201.   FINCLUDE(STDIN)
  202. END;
  203.   
  204. PROCEDURE CONCAT;
  205. VAR
  206.   I:INTEGER;
  207.   JUNK:BOOLEAN;
  208.   FD:FILEDESC;
  209.   S:XSTRING;
  210. BEGIN
  211.   FOR I:=2 TO NARGS DO BEGIN
  212.     JUNK:=GETARG(I,S,MAXSTR);
  213.     FD:=MUSTOPEN(S,IOREAD);
  214.     FCOPY(FD,STDOUT);
  215.     XCLOSE(FD)
  216.   END
  217. END;
  218.  
  219. PROCEDURE ARCHIVE;
  220. CONST
  221.   MAXFILES=10;
  222. VAR
  223.   ANAME:XSTRING;
  224.   CMD:XSTRING;
  225.   FNAME:ARRAY[1..MAXFILES]OF XSTRING;
  226.   FSTAT:ARRAY[1..MAXFILES] OF BOOLEAN;
  227.   NFILES:INTEGER;
  228.   ERRCOUNT:INTEGER;
  229.   ARCHTEMP:XSTRING;
  230.   ARCHHDR:XSTRING;
  231. FUNCTION GETWORD(VAR S:XSTRING;I:INTEGER;VAR OUT:XSTRING):INTEGER;
  232. VAR
  233.   J:INTEGER;
  234. BEGIN
  235.   WHILE (S[I] IN [BLANK,TAB,NEWLINE]) DO
  236.     I:=I+1;
  237.   J:=1;
  238.   WHILE(NOT (S[I] IN [ENDSTR,BLANK,TAB,NEWLINE])) DO BEGIN
  239.     OUT[J]:=S[I];
  240.     I:=I+1;
  241.     J:=J+1
  242.   END;
  243.   OUT[J]:=ENDSTR;
  244.   IF(S[I]=ENDSTR) THEN
  245.     GETWORD:=0
  246.   ELSE
  247.     GETWORD:=I
  248. END;
  249.  
  250.  
  251. FUNCTION GETHDR(FD:FILEDESC;VAR BUF,NAME:XSTRING;
  252.   VAR SIZE:INTEGER):BOOLEAN;
  253. VAR
  254.   TEMP:XSTRING;
  255.   I:INTEGER;
  256. BEGIN
  257.   IF(GETLINE(BUF,FD,MAXSTR)=FALSE)THEN
  258.     GETHDR:=FALSE
  259.   ELSE BEGIN
  260.     I:=GETWORD(BUF,1,TEMP);
  261.     IF(NOT EQUAL(TEMP,ARCHHDR))THEN
  262.       ERROR('ARCHIVE NOT IN PROPER FORMAT');
  263.     I:=GETWORD(BUF,I,NAME);
  264.     SIZE:=CTOI(BUF,I);
  265.     GETHDR:=TRUE
  266.   END
  267. END;
  268.  
  269. FUNCTION FILEARG (VAR NAME:XSTRING):BOOLEAN;
  270. VAR
  271.   I:INTEGER;
  272.   FOUND:BOOLEAN;
  273. BEGIN
  274.   IF(NFILES<=0)THEN
  275.     FILEARG:=TRUE
  276.   ELSE BEGIN
  277.     FOUND:=FALSE;
  278.     I:=1;
  279.     WHILE(NOT FOUND) AND (I<=NFILES)DO BEGIN
  280.       IF(EQUAL(NAME,FNAME[I])) THEN BEGIN
  281.         FSTAT[I]:=TRUE;
  282.         FOUND:=TRUE
  283.       END;
  284.       I:=I+1
  285.     END;
  286.     FILEARG:=FOUND
  287.   END
  288. END;
  289.  
  290. PROCEDURE FSKIP(FD:FILEDESC;N:INTEGER);
  291. VAR
  292.   C:CHARACTER;
  293.   I:INTEGER;
  294. BEGIN
  295.   FOR I:=1 TO N DO
  296.     IF(GETCF(C,FD)=ENDFILE)THEN
  297.       ERROR('ARCHIVE:END OF FILE IN FSKIP')
  298. END;
  299.  
  300. PROCEDURE FMOVE(VAR NAME1,NAME2:XSTRING);
  301. VAR
  302.   FD1,FD2:FILEDESC;
  303. BEGIN
  304.   FD1:=MUSTOPEN(NAME1,IOREAD);
  305.   FD2:=MUSTCREATE(NAME2,IOWRITE);
  306.   FCOPY(FD1,FD2);
  307.   XCLOSE(FD1);
  308.   XCLOSE(FD2)
  309. END;
  310.  
  311.  
  312. PROCEDURE ACOPY(FDI,FDO:FILEDESC;N:INTEGER);
  313. VAR
  314.   C:CHARACTER;
  315.   I:INTEGER;
  316. BEGIN
  317.   FOR I:=1 TO N DO
  318.     IF (GETCF(C,FDI)=ENDFILE)THEN
  319.       ERROR('ARCHIVE: END OF FILE IN ACOPY')
  320.     ELSE
  321.       PUTCF(C,FDO)
  322. END;
  323.  
  324. PROCEDURE NOTFOUND;
  325. VAR
  326.   I:INTEGER;
  327. BEGIN
  328.   FOR I := 1 TO NFILES DO
  329.     IF(FSTAT[I]=FALSE)THEN BEGIN
  330.       PUTSTR(FNAME[I],STDERR);
  331.       WRITELN(':NOT IN ARCHIVE');
  332.       ERRCOUNT:=ERRCOUNT + 1
  333.     END
  334. END;
  335.  
  336. PROCEDURE ADDFILE(VAR NAME:XSTRING;FD:FILEDESC);
  337. VAR
  338.   HEAD:XSTRING;
  339.   NFD:FILEDESC;
  340. PROCEDURE MAKEHDR(VAR NAME,HEAD:XSTRING);
  341. VAR
  342.   I:INTEGER;
  343. FUNCTION FSIZE(VAR NAME:XSTRING):INTEGER;
  344. VAR
  345.   C:CHARACTER;
  346.   FD:FILEDESC;
  347.   N:INTEGER;
  348. BEGIN
  349.   N:=0;
  350.   FD:=MUSTOPEN(NAME,IOREAD);
  351.   WHILE(GETCF(C,FD)<>ENDFILE)DO
  352.     N:=N+1;
  353.   XCLOSE(FD);
  354.   FSIZE:=N
  355. END;
  356.  
  357. BEGIN
  358.   SCOPY(ARCHHDR,1,HEAD,1);
  359.   I:=XLENGTH(HEAD)+1;
  360.   HEAD[I]:=BLANK;
  361.   SCOPY(NAME,1,HEAD,I+1);
  362.   I:=XLENGTH(HEAD)+1;
  363.   HEAD[I]:=BLANK;
  364.   I:=ITOC(FSIZE(NAME),HEAD,I+1);
  365.   HEAD[I]:=NEWLINE;
  366.   HEAD[I+1]:=ENDSTR
  367. END;
  368.  
  369. BEGIN
  370.   NFD:=OPEN(NAME,IOREAD);
  371.   IF(NFD=IOERROR)THEN BEGIN
  372.     PUTSTR(NAME,STDERR);
  373.     WRITELN(':CAN''T ADD');
  374.     ERRCOUNT:=ERRCOUNT+1
  375.   END;
  376.   IF(ERRCOUNT=0)THEN BEGIN
  377.     MAKEHDR(NAME,HEAD);
  378.     PUTSTR(HEAD,FD);
  379.     FCOPY(NFD,FD);
  380.     XCLOSE(NFD)
  381.   END
  382. END;
  383.  
  384.  
  385. PROCEDURE REPLACE(AFD,TFD:FILEDESC;CMD:INTEGER);
  386. VAR
  387.   PINLINE,UNAME:XSTRING;
  388.   SIZE:INTEGER;
  389. BEGIN
  390.   WHILE(GETHDR(AFD,PINLINE,UNAME,SIZE))DO
  391.     IF(FILEARG(UNAME))THEN BEGIN
  392.       IF(CMD=ORD('U'))THEN
  393.         ADDFILE(UNAME,TFD);
  394.       FSKIP(AFD,SIZE)
  395.     END
  396.     ELSE BEGIN
  397.       PUTSTR(PINLINE,TFD);
  398.       ACOPY(AFD,TFD,SIZE)
  399.     END
  400. END;
  401.  
  402. PROCEDURE HELP;
  403. BEGIN
  404.   ERROR('USAGE:ARCHIVE -[CDPTUX] ARCHNAME [FILES...]')
  405. END;
  406.  
  407.  
  408. PROCEDURE GETFNS;
  409. VAR
  410.   I,J:INTEGER;
  411.   JUNK:BOOLEAN;
  412. BEGIN
  413.   ERRCOUNT:=0;
  414.   NFILES:=NARGS-3;
  415.   IF(NFILES>MAXFILES)THEN
  416.     ERROR('ARCHIVE:TO MANY FILE NAMES');
  417.   FOR I:=1 TO NFILES DO
  418.     JUNK:=GETARG(I+3,FNAME[I],MAXSTR);
  419.   FOR I:=1 TO NFILES DO
  420.    FSTAT[I]:=FALSE;
  421.   FOR I:=1 TO NFILES-1 DO
  422.     FOR J:=I+1 TO NFILES DO
  423.       IF(EQUAL(FNAME[I],FNAME[J]))THEN BEGIN
  424.         PUTSTR(FNAME[I],STDERR);
  425.         ERROR(':DUPLICATE FILENAME')
  426.       END
  427. END;
  428.  
  429.  
  430. PROCEDURE UPDATE(VAR ANAME:XSTRING;CMD:CHARACTER);
  431. VAR
  432.   I:INTEGER;
  433.   AFD,TFD:FILEDESC;
  434. BEGIN
  435.   TFD:=MUSTCREATE(ARCHTEMP,IOWRITE);
  436.   IF(CMD=ORD('u')) THEN BEGIN
  437.    AFD:=MUSTOPEN(ANAME,IOREAD);
  438.    REPLACE(AFD,TFD,ORD('u'));(*UPDATE EXISTING*)
  439.    XCLOSE(AFD)
  440.  END;
  441.  FOR I:=1 TO NFILES DO
  442.    IF(FSTAT[I]=FALSE)THEN BEGIN
  443.       ADDFILE(FNAME[I],TFD);
  444.       FSTAT[I]:=TRUE
  445.     END;
  446.     XCLOSE(TFD);
  447.     IF(ERRCOUNT=0)THEN
  448.       FMOVE(ARCHTEMP,ANAME)
  449.     ELSE
  450.       WRITELN('FATAL ERRORS - ARCHIVE NOT ALTERED');
  451.     REMOVE (ARCHTEMP)
  452.   END;
  453. PROCEDURE TABLE(VAR ANAME:XSTRING);
  454. VAR
  455.   HEAD,NAME:XSTRING;
  456.   SIZE:INTEGER;
  457.   AFD:FILEDESC;
  458. PROCEDURE TPRINT(VAR BUF:XSTRING);
  459. VAR
  460.   I:INTEGER;
  461.   TEMP:XSTRING;
  462. BEGIN
  463.   I:=GETWORD(BUF,1,TEMP);
  464.   I:=GETWORD(BUF,I,TEMP);
  465.   PUTSTR(TEMP,STDOUT);
  466.   PUTC(BLANK);
  467.   I:=GETWORD(BUF,I,TEMP);(*SIZE*)
  468.   PUTSTR(TEMP,STDOUT);
  469.   PUTC(NEWLINE)
  470. END;
  471.  
  472. BEGIN
  473.   AFD:=MUSTOPEN(ANAME,IOREAD);
  474.   WHILE(GETHDR(AFD,HEAD,NAME,SIZE))DO BEGIN
  475.     IF(FILEARG(NAME))THEN
  476.       TPRINT(HEAD);
  477.     FSKIP(AFD,SIZE)
  478.   END;
  479.   NOTFOUND
  480. END;
  481.  
  482. PROCEDURE EXTRACT (VAR ANAME:XSTRING;CMD:CHARACTER);
  483. VAR
  484.   ENAME,PINLINE:XSTRING;
  485.   AFD,EFD:FILEDESC;
  486.   SIZE : INTEGER;
  487. BEGIN
  488.   AFD:=MUSTOPEN(ANAME,IOREAD);
  489.   IF (CMD=ORD('p')) THEN
  490.     EFD:=STDOUT
  491.   ELSE
  492.     EFD:=IOERROR;
  493.   WHILE (GETHDR(AFD,PINLINE,ENAME,SIZE)) DO
  494.     IF (NOT FILEARG(ENAME))THEN
  495.       FSKIP(AFD,SIZE)
  496.     ELSE
  497.       BEGIN
  498.       IF (EFD<> STDOUT) THEN
  499.         EFD:=CREATE(ENAME,IOWRITE);
  500.       IF(EFD=IOERROR) THEN BEGIN
  501.         PUTSTR(ENAME,STDERR);
  502.         WRITELN(': CANT''T CREATE');
  503.         ERRCOUNT:=ERRCOUNT+1;
  504.         FSKIP(AFD,SIZE)
  505.       END
  506.       ELSE BEGIN
  507.         ACOPY(AFD,EFD,SIZE);
  508.         IF(EFD<>STDOUT)THEN
  509.         XCLOSE(EFD)
  510.       END
  511.     END;
  512.     NOTFOUND
  513.   END;
  514.  
  515. PROCEDURE DELETE(VAR ANAME:XSTRING);
  516. VAR
  517.   AFD,TFD:FILEDESC;
  518. BEGIN
  519.   IF(NFILES<=0)THEN(*PROTECT INNOCENT*)
  520.     ERROR('ARCHIVE:-D REQUIRES EXPLICIT FILE NAMES');
  521.   AFD:=MUSTOPEN(ANAME,IOREAD);
  522.   TFD:=MUSTCREATE(ARCHTEMP,IOWRITE);
  523.   REPLACE(AFD,TFD,ORD('d'));
  524.   NOTFOUND;
  525.   XCLOSE(AFD);
  526.   XCLOSE(TFD);
  527.   IF(ERRCOUNT=0)THEN
  528.     FMOVE(ARCHTEMP,ANAME)
  529.   ELSE
  530.     WRITELN('FATAL ERRORS - ARCHIVE NOT ALTERED');
  531.   REMOVE(ARCHTEMP)
  532. END;
  533.  
  534.  
  535. PROCEDURE INITARCH;
  536. BEGIN
  537.   ARCHTEMP[1]:=ORD('A');
  538.   ARCHTEMP[2]:=ORD('R');
  539.   ARCHTEMP[3]:=ORD('T');
  540.   ARCHTEMP[4]:=ORD('E');
  541.   ARCHTEMP[5]:=ORD('M');
  542.   ARCHTEMP[6]:=ORD('P');
  543.   ARCHTEMP[7]:=ENDSTR;
  544.   ARCHHDR[1]:=ORD('-');
  545.   ARCHHDR[2]:=ORD('H');
  546.   ARCHHDR[3]:=ORD('-');
  547.   ARCHHDR[4]:=ENDSTR;
  548. END;
  549.  
  550.  
  551. BEGIN
  552.   INITARCH;
  553.   IF (NOT GETARG(2,CMD,MAXSTR))
  554.     OR(NOT GETARG(3,ANAME,MAXSTR)) THEN
  555.       HELP;
  556.   GETFNS;
  557.   IF(XLENGTH(CMD)<>2) OR(CMD[1]<>ORD('-')) THEN
  558.     HELP
  559.   ELSE IF (CMD[2]=ORD('c'))OR(CMD[2]=ORD('u'))THEN
  560.     UPDATE(ANAME,CMD[2])
  561.   ELSE IF (CMD[2]=ORD('t'))THEN
  562.     TABLE(ANAME)
  563.   ELSE IF (CMD[2]=ORD('x'))OR(CMD[2]=ORD('p'))THEN
  564.     EXTRACT(ANAME,CMD[2])
  565.   ELSE IF (CMD[2]=ORD('d'))THEN
  566.     DELETE(ANAME)
  567.   ELSE
  568.     HELP
  569. END;
  570.  
  571. PROCEDURE COMMAND;
  572. VAR I:INTEGER;XS:XSTRING;B:BOOLEAN;
  573.   S:PACKED ARRAY[1..3]OF CHAR;
  574. BEGIN
  575.   B:=GETARG(1,XS,MAXSTR);
  576.   IF (B=TRUE)THEN BEGIN
  577.     for i:=1 to 3 do
  578.       if islower(xs[i])then s[i]:=chr(xs[i]-32)else s[i]:=chr(xs[i]);
  579.   END
  580.   ELSE bdos(0,0);
  581.   IF(S='COM')THEN COMPARE
  582.   ELSE IF (S='INC')THEN INCLUDE
  583.   ELSE IF (S='CON')THEN CONCAT
  584.   ELSE IF (S='PRI')THEN PRINT
  585.   ELSE IF (S='MAK')THEN MAKECOPY
  586.   ELSE IF (S='ARC')THEN ARCHIVE
  587. END;
  588.  
  589. BEGIN
  590.   COMMAND;
  591.   ENDCMD;ASSIGN(CMDPTR,'SHELL.COM');EXECUTE(CMDPTR);
  592. END.
  593.  
  594.  
  595.